home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Periodicals / develop / develop 4 code / Perils of PS II / Perils of PS II (THINK) / Tips2.think.p next >
Encoding:
Text File  |  1990-09-12  |  7.0 KB  |  193 lines  |  [TEXT/PJMM]
  1. program Tips1;
  2.  
  3. {$IFC THINK_PASCAL}
  4. {If you are using THINK Pascal use this set of includes and}
  5. {add the library 'printCalls.lib' to your project.}
  6.     uses
  7.         printing;
  8.  
  9. {$ElseC}
  10. {If you are using MPW Pascal use this set of includes.}
  11.     uses
  12.         Memtypes, QuickDraw, OSIntf, ToolIntf, PackIntf, MacPrint;
  13.  
  14. {$EndC}
  15.  
  16.  
  17.  
  18.     const
  19.         PostScriptBegin = 190;
  20.         PostScriptEnd = 191;
  21.         PostScriptHandle = 192;
  22.         PostScriptBeginNoSave = 196;
  23.  
  24.     procedure SendPostScript (theComment: Str255);
  25.         var
  26.             PSCommand: Str255;
  27.             CommandHdl: Handle;
  28.             CRString: Str255;
  29.             theError: OSErr;
  30.     begin
  31.         CRString := ' ';
  32.         CRString[1] := CHR(13);
  33.         PSCommand := theComment;
  34.         PSCommand := CONCAT(PSCommand, CRString);
  35.         theError := PtrToHand(POINTER(ORD(@PSCommand) + 1), CommandHdl, LENGTH(PSCommand));
  36.         if theError <> noErr then
  37.             begin
  38.             (* Handle the error! *)
  39.             end;
  40.         PicComment(PostScriptHandle, LENGTH(PSCommand), CommandHdl);
  41.         DisposHandle(CommandHdl);
  42.     end;
  43.  
  44.     procedure SetFont (fontName: Str255; fontSize: INTEGER; fontStyle: Style);
  45.         var
  46.             theFontID: INTEGER;
  47.             thePenLoc: Point;
  48.     begin
  49.         GetFNum(fontName, theFontID);       (* Get the font ID.                         *)
  50.         TextFont(theFontID);                (* Set it.                                  *)
  51.         TextSize(fontSize);                 (* Set the size...                          *)
  52.         TextFace(fontStyle);                (* ...and the style.                        *)
  53.         GetPen(thePenLoc);                  (* Save the current pen position.           *)
  54.         DrawChar(' ');                      (* Draw a space so the font gets downloaded.*)
  55.         MoveTo(thePenLoc.h, thePenLoc.v);   (* Restore the original pen position.       *)
  56.     end;
  57.  
  58.     procedure DrawStuff (theWorld: Rect);
  59.     { Draw whatever you want here.  Make sure it fits in the world rectangle. }
  60.     begin
  61.     (* First, let's define a PostScript dictionary.  Since we aren't actually    *)
  62.     (* drawing anything, we don't need to turn off Quickdraw (ie. we don't need    *)
  63.     (* the PostScriptBegin/End comments).                                        *)
  64.     (* First create a dictionary that can hold 10 objects. *)
  65.         SendPostScript('/mydict 10 dict def');
  66.     (* Now make it current.  All implicit operations from now on will go to    *)
  67.     (* mydict.                                                                *)
  68.         SendPostScript('mydict begin');
  69.     (* Now define the routine to save the definition of bu on the stack, and*)
  70.     (* then define it to do nothing.                                        *)
  71.         SendPostScript('/killbu {//md /bu get //md /bu {} put} def');
  72.     (* Now define a routine to pop the old definition of bu off the stack,    *)
  73.     (* and back into the bu symbol.                                            *)
  74.         SendPostScript('/restorebu {//md exch /bu exch put} def');
  75.     (* Now do the same for bn.                                                *)
  76.         SendPostScript('/killbn {//md /bn get //md /bn {} put} def');
  77.         SendPostScript('/restorebn {//md exch /bn exch put} def');
  78.     (* Now define a test routine that we can execute to see if our dict was    *)
  79.     (* truly preserved.                                                        *)
  80.         SendPostScript('/titleshow {dup gsave');
  81.         SendPostScript('currentscreen 3 -1 roll pop 120 3 1 roll setscreen');
  82.         SendPostScript('.5 setgray show grestore true charpath gsave');
  83.         SendPostScript('1 setlinewidth 0 setgray stroke grestore');
  84.         SendPostScript('.5 setlinewidth 1 setgray stroke }def');
  85.     (* This ends the 'mydict begin' above, restoring md as the current dict.*)
  86.         SendPostScript('end');
  87.  
  88.     (* Okay, now we have our dictionary defined, we need to kill off those    *)
  89.     (* nasty bn and bu operators before they kill us (ie. before a font     *)
  90.     (* download).                                                            *)
  91.     (* First point to our dictionary.                                        *)
  92.         SendPostScript('mydict begin');
  93.     (* Now kill off bu, saving its original definition on the stack.        *)
  94.         SendPostScript('//md /bu known {killbu} if');
  95.     (* ...and the same for bn.                                                *)
  96.         SendPostScript('//md /bn known {killbn} if');
  97.     (*************************** IMPORTANT **********************************)
  98.     (* Since the definition of bu and bn have been saved on the stack, they    *)
  99.     (* must be restored in the opposite order that they were killed.  In     *)
  100.     (* this case, bu was killed first, so restorebn must be called before    *)
  101.     (* restorebu.  If not, the routines will be reversed, and you will get    *)
  102.     (* a limitcheck (out of memory) error in short order.                    *)
  103.     (*************************** IMPORTANT **********************************)
  104.         SendPostScript('end');
  105.  
  106.     (* Set the font using our new SetFont routine.  This will set the font     *)
  107.     (* for both the Quickdraw and PostScript worlds.  Since we have killed    *)
  108.     (* bn and bu, this should have no effect on our PostScript dictionary.    *)
  109.         SetFont('Times', 50, [bold]);
  110.  
  111.         PicComment(PostScriptBegin, 0, nil);
  112.         (********************************************)
  113.         (*** Quickdraw representation of graphic. ***)
  114.         (********************************************)
  115.         (* These calls are only executed by Quickdraw (i.e. non-PostScript)    *)
  116.         (* devices.                                                            *)
  117.         MoveTo(100, 100);
  118.         DrawString('UnFancy Title');
  119.  
  120.         (*********************************************)
  121.         (*** PostScript representation of graphic. ***)
  122.         (*********************************************)
  123.         SendPostScript('mydict begin');        (* Point to ours.            *)
  124.         SendPostScript('100 100 moveto (Fancy Title) titleshow');                (* Execute test.            *)
  125.         SendPostScript('end');                (* Reset back to last dict.    *)
  126.         PicComment(PostScriptEnd, 0, nil);
  127.  
  128.     (* Now we're all done with our job, so to be polite, we restore the    *)
  129.     (* original definitions of bn and bu.  REMEMBER that the restorexx    *)
  130.     (* routines must be executed in the opposite order that the killxx    *)
  131.     (* routines were.                                                    *)
  132.         SendPostScript('mydict begin');
  133.         SendPostScript('//md /bn known {restorebn} if');
  134.         SendPostScript('//md /bu known {restorebu} if');
  135.         SendPostScript('end');
  136.     end;
  137.  
  138.  
  139.     procedure PrintStuff;
  140.         var
  141.             thePrRec: THPrint;
  142.             thePrPort: TPPrPort;
  143.             theStatus: TPrStatus;
  144.             oldPort: GrafPtr;
  145.             theError: OSErr;
  146.             theVers: INTEGER;
  147.  
  148.     begin
  149.         GetPort(oldPort);
  150.         thePrRec := THPrint(NewHandle(SIZEOF(TPrint)));
  151.  
  152.         PrOpen;
  153.         theVers := PrDrvrVers;
  154.         if PrError = noErr then
  155.             begin
  156.                 PrintDefault(thePrRec);
  157.                 if not PrStlDialog(thePrRec) then
  158.                     ExitToShell;
  159.                 if not PrJobDialog(thePrRec) then
  160.                     ExitToShell;
  161.                 thePrPort := PrOpenDoc(thePrRec, nil, nil);
  162.                 if PrError = noErr then
  163.                     begin
  164.                         PrOpenPage(thePrPort, nil);
  165.                         if PrError = noErr then
  166.                             begin
  167.  
  168.                                 DrawStuff(thePrRec^^.prInfo.rPage);
  169.  
  170.                             end;
  171.                         PrClosePage(thePrPort)
  172.                     end;
  173.                 PrCloseDoc(thePrPort);
  174.                 if (thePrRec^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) then
  175.                     PrPicFile(thePrRec, nil, nil, nil, theStatus);
  176.             end;
  177.         PrClose;
  178.  
  179.         SetPort(oldPort);
  180.     end;
  181.  
  182. begin
  183.     InitGraf(@thePort);                  {initialize QuickDraw}
  184.     InitFonts;                                    {initialize Font Manager}
  185.     FlushEvents(everyEvent, 0); {call OS Event Mgr to discard any previous events}
  186.     InitWindows;                               {initialize Window Manager}
  187.     InitMenus;                                    {initialize Menu Manager}
  188.     TEInit;                                       {initialize TextEdit}
  189.     InitDialogs(nil);                       {initialize Dialog Manager}
  190.     InitCursor;                                {call QuickDraw to make cursor (pointer) an arrow}
  191.  
  192.     PrintStuff;
  193. end.